home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / values < prev    next >
Text File  |  1993-04-02  |  690b  |  26 lines
  1. ; By david carlton, carlton@husc.harvard.edu.  This code is in the
  2. ; public domain.
  3.  
  4. (require 'record)
  5.  
  6. (define values:*values-rtd*
  7.   (make-record-type "values"
  8.             '(values)))
  9.  
  10. (define values
  11.   (let ((make-values (record-constructor values:*values-rtd*)))
  12.     (lambda x
  13.       (if (and (not (null? x))
  14.            (null? (cdr x)))
  15.       (car x)
  16.       (make-values x)))))
  17.  
  18. (define call-with-values
  19.   (let ((access-values (record-accessor values:*values-rtd* 'values))
  20.     (values-predicate? (record-predicate values:*values-rtd*)))
  21.     (lambda (producer consumer)
  22.       (let ((result (producer)))
  23.     (if (values-predicate? result)
  24.         (apply consumer (access-values result))
  25.         (consumer result))))))
  26.